home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_87 / songutil.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  5KB  |  187 lines
  1. UNIT SongUtils;
  2.  
  3. INTERFACE
  4.  
  5. USES SongUnit, SongElements;
  6.  
  7.  
  8.  
  9.  
  10. {----------------------------------------------------------------------------}
  11. { Definitions for accelerating the use of note periods.                      }
  12. {____________________________________________________________________________}
  13.  
  14. CONST
  15.   NumberOctaves = 7;
  16.   NumberNotes   = 12;
  17.   NumberPeriods = NumberOctaves * NumberNotes;
  18.  
  19. TYPE
  20.   TPeriodSet = ARRAY[0..NumberOctaves-1] OF         { Octave }
  21.                ARRAY[0..NumberNotes  -1] OF WORD;   { Note   }
  22.  
  23.   TPeriodArray = ARRAY[0..NumberPeriods - 1] OF WORD;
  24.  
  25. CONST
  26.   { The different note values. }
  27.  
  28.   PeriodSet : TPeriodSet = (
  29.     {  C     C#    D     D#    E     F     F#    G     G#    A     A#    B  }
  30.     ($06B0,$0650,$05F5,$05A0,$054F,$0503,$04BB,$0477,$0436,$03FA,$03C1,$038B),
  31.     ($0358,$0328,$02FB,$02D0,$02A7,$0281,$025D,$023B,$021B,$01FD,$01E0,$01C5),
  32.     ($01AC,$0194,$017D,$0168,$0154,$0141,$012F,$011E,$010E,$00FE,$00F0,$00E3),
  33.     ($00D6,$00CA,$00BF,$00B4,$00AA,$00A0,$0097,$008F,$0087,$007F,$0078,$0071),
  34.     ($006B,$0065,$005F,$005A,$0055,$0050,$004C,$0047,$0043,$0040,$003C,$0039),
  35.     ($0035,$0032,$0030,$002D,$002A,$0028,$0026,$0024,$0022,$0020,$001E,$001C),
  36.     ($001B,$0019,$0018,$0016,$0015,$0014,$0013,$0012,$0011,$0010,$000F,$000E)
  37.   );
  38.  
  39.   { The different inter-note values. }
  40.  
  41.   PeriodDiff : TPeriodSet = (
  42.     ($0680,$0622,$05CA,$0577,$0529,$04DF,$0499,$0456,$0418,$03DD,$03A6,$0371),
  43.     ($0340,$0311,$02E5,$02BB,$0294,$026F,$024C,$022B,$020C,$01EE,$01D2,$01B8),
  44.     ($01A0,$0188,$0172,$015E,$014A,$0138,$0126,$0116,$0106,$00F7,$00E9,$00DC),
  45.     ($00D0,$00C4,$00B9,$00AF,$00A5,$009B,$0093,$008B,$0083,$007B,$0074,$006E),
  46.     ($0068,$0062,$005C,$0057,$0052,$004E,$0049,$0045,$0041,$003E,$003A,$0037),
  47.     ($0033,$0031,$002E,$002B,$0029,$0027,$0025,$0023,$0021,$001F,$001D,$001B),
  48.     ($001A,$0018,$0017,$0015,$0014,$0013,$0012,$0011,$0010,$000F,$000E,$000E)
  49.   );
  50.  
  51. VAR
  52.   PeriodArray : TPeriodArray ABSOLUTE PeriodSet;
  53.  
  54. TYPE
  55.   TNoteString    = STRING[3];
  56.  
  57.   TNoteSet       = ARRAY[0..2047] OF WORD;
  58.   TNoteStringSet = ARRAY[0..NumberPeriods] OF TNoteString;
  59.  
  60. VAR
  61.   NoteIdx : TNoteSet;       { For each period, specifies its closest note, in two ways:      }
  62.                             {   Hi byte: octave in the hi nibble and note in the low nibble. }
  63.                             {  Low byte: sequential note for indexing.                       }
  64.  
  65.   NoteStr : TNoteStringSet; { The strings for each note (e.g. 'A#2'). }
  66.  
  67.  
  68.  
  69.  
  70. FUNCTION  SwapLong (l: LONGINT)                  : LONGINT;
  71. PROCEDURE NoteFreq (f: WORD; VAR s: TNoteString);
  72.  
  73. PROCEDURE InitModVideoTables;
  74. PROCEDURE InitModUnit;
  75.  
  76. FUNCTION  FullNotesEqual (VAR fn1, fn2: TFullNote) : BOOLEAN;
  77.  
  78.  
  79.  
  80. IMPLEMENTATION
  81.  
  82.  
  83.  
  84.  
  85.  
  86. FUNCTION SwapLong(l: LONGINT) : LONGINT;
  87.   VAR
  88.     w : ARRAY[0..1] OF WORD ABSOLUTE l;
  89.     r : WORD;
  90.   BEGIN
  91.     r    := SWAP(w[0]);
  92.     w[0] := SWAP(w[1]);
  93.     w[1] := r;
  94.     SwapLong := l;
  95.   END;
  96.  
  97.  
  98.  
  99.  
  100. PROCEDURE NoteFreq(f: WORD; VAR s: TNoteString);
  101.   BEGIN
  102.     IF f > 2047 THEN
  103.       f := 2047;
  104.  
  105.     s := NoteStr[NoteIdx[f] AND $FF];
  106. {    STR(f, s);}
  107.   END;
  108.  
  109.  
  110.  
  111.  
  112. {----------------------------------------------------------------------------}
  113. { Initialization routines.                                                   }
  114. {____________________________________________________________________________}
  115.  
  116. PROCEDURE InitModUnit;
  117.   VAR
  118.     l    : LONGINT;
  119.     f,
  120.     o, i : WORD;
  121.   LABEL
  122.     Octava, NextFreq;
  123.   BEGIN
  124.     FOR f := 0 TO 2047 DO BEGIN
  125.  
  126.       FOR o := 0 TO 6 DO
  127.         IF f > PeriodDiff[o][11] THEN GOTO Octava;
  128.       i := 0; o := 0;
  129.       GOTO NextFreq;
  130.  
  131. Octava:
  132.       FOR i := 0 TO 11 DO
  133.         IF f > PeriodDiff[o][i]  THEN GOTO NextFreq;
  134.       i := 0; o := 0;
  135.  
  136. NextFreq:
  137.       NoteIdx[f] := (o*16+i)*256 + (o*12+i)
  138.  
  139.     END;
  140.   END;
  141.  
  142.  
  143.  
  144.  
  145. PROCEDURE InitModVideoTables;
  146.   CONST
  147.     NoteLet : STRING[12] = 'CCDDEFFGGAAB';
  148.     NoteSus : STRING[12] = ' # #  # # # ';
  149.   VAR
  150.     o, i : WORD;
  151.     s    : STRING[3];
  152.   BEGIN
  153.      FOR i := 0 TO 12*7-1 DO BEGIN
  154.        s[0] := CHR(3);
  155.        o    := i DIV 12;
  156.        s[3] := CHR(o + ORD('0'));
  157.        o    := i MOD 12 + 1;
  158.        s[1] := NoteLet[o];
  159.        s[2] := NoteSus[o];
  160.  
  161.        NoteStr[i] := s;
  162.      END;
  163.  
  164.      NoteStr[12*7] := '---';
  165.   END;
  166.  
  167.  
  168.  
  169.  
  170. FUNCTION  FullNotesEqual (VAR fn1, fn2: TFullNote) : BOOLEAN;
  171.   TYPE
  172.     TFNArray = ARRAY[1..SizeOf(TFullNote)] OF BYTE;
  173.   VAR
  174.     fna1 : TFNArray ABSOLUTE fn1;
  175.     fna2 : TFNArray ABSOLUTE fn2;
  176.     i    : WORD;
  177.   BEGIN
  178.     FullNotesEqual := FALSE;
  179.     FOR i := 1 TO SizeOf(TFullNote) DO
  180.       IF fna1[i] <> fna2[i] THEN EXIT;
  181.     FullNotesEqual := TRUE;
  182.   END;
  183.  
  184.  
  185.  
  186.  
  187. END.